home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / ISSUE18 / SURVIVE / LOGIN.PAS < prev    next >
Pascal/Delphi Source File  |  1996-12-06  |  14KB  |  429 lines
  1. unit Login;
  2.  
  3. interface
  4.  
  5. uses
  6.   Classes, Forms, SysUtils, DB, DBTables;
  7.  
  8. const
  9.   cNoUserID         = -1;   { Token for no user connected }
  10.   cNoAppID          = -1;   { Token for no application defined }
  11.   DefNumAttempts    = 3;    { Default number of login retry attempts }
  12.  
  13. type
  14.   TLoginEvent = procedure(Sender: TObject; UserName: string; Password: string) of object;
  15.   TLoggingInEvent = procedure(Sender: TObject; UserName: string; Password: string; var Cancel: Boolean) of object;
  16.   TLoggingOutEvent = procedure(Sender: TObject; var Cancel: Boolean) of object;
  17.   TPasswordExpiredEvent = procedure (Sender: TObject; var Cancel: Boolean) of object;
  18.  
  19.   TDBList = class(TList)
  20.   public
  21.     function Add(Item: TDatabase): Integer;
  22.   end;
  23.  
  24.   TLoginManager = class(TComponent)
  25.   protected
  26.     FApplicationDBs: TDBList;      { List of ancillary TDatabase components }
  27.     FApplicationID: LongInt;       { Identifier for the application }
  28.     FCallersDatabaseName: string;  { Application's dbname for main db }
  29.     FCallersServerName: string;    { Application's server name for main db }
  30.     FDatabaseName: string;         { Db name for main db for this connection }
  31.     FDateLastLogin: TDateTime;     { Date/time of the last login for this user }
  32.     FPasswordExpired: Boolean;     { True if user's password has expired on this login }
  33.     FMainDB: TDatabase;            { Pointer to the application's TDatabase component }
  34.     FNumAttemptsAllowed: Integer;  { Number of login retries allowed }
  35.     FNumFailedAttempts: Integer;   { Number of failed login attempts so far }
  36.     FPassword: string;             { User's password }
  37.     FServerName: string;           { Server name for main db for this connection }
  38.     FUserFirstName: string;        { Proper first name for user }
  39.     FUserFullName: string;         { Proper full name for user }
  40.     FUserLastName: string;         { Proper last name for user }
  41.     FUserID: LongInt;              { System ID for user }
  42.     FUsername: string;             { Login username for user }
  43.     FOnLogin: TLoginEvent;         { Event-handler }
  44.     FOnLoggingIn: TLoggingInEvent; { Event-handler }
  45.     FOnLogout: TNotifyEvent;       { Event-handler }
  46.     FOnLoggingOut: TLoggingOutEvent; { Event-handler }
  47.     FOnBadLogin: TNotifyEvent;     { Event-handler }
  48.     FOnPasswordExpired: TPasswordExpiredEvent;
  49.  
  50.     procedure Connect;
  51.     procedure ConnectDB(DB: TDatabase; Username, Password: string);
  52.     procedure Disconnect;
  53.     procedure DisconnectDB(DB: TDatabase);
  54.     function GetDBParamValue(ParamName: string): string;
  55.     procedure SetDatabaseName(Value: string);
  56.     procedure SetDBParamValue(ParamName, Value: string);
  57.     procedure SetMainDB(Value: TDatabase);
  58.     procedure SetServerName(Value: string);
  59.   public
  60.     constructor Create(AOwner: TComponent); override;
  61.     destructor Destroy; override;
  62.     procedure Login(UserName, Password, Server, Database: string);
  63.     procedure Logout;
  64.     procedure ChangePassword(OldPassword, NewPassword: string);
  65.  
  66.     property ApplicationDBs: TDBList
  67.       read FApplicationDBs write FApplicationDBs;
  68.     property ApplicationID: LongInt
  69.       read FApplicationID write FApplicationID;
  70.     property DatabaseName: string
  71.       read FDatabaseName;
  72.     property MainDB: TDatabase
  73.       read FMainDB write SetMainDB;
  74.     property NumAttemptsAllowed: Integer
  75.       read FNumAttemptsAllowed write FNumAttemptsAllowed default defNumAttempts;
  76.     property Password: string
  77.       read FPassword;
  78.     property ServerName: string
  79.       read FServerName;
  80.     property UserFirstName: string
  81.       read FUserFirstName;
  82.     property UserFullName: string
  83.       read FUserFullName;
  84.     property UserLastName: string
  85.       read FUserLastName;
  86.     property UserID: LongInt
  87.       read FUserID;
  88.     property Username: string
  89.       read FUsername;
  90.  
  91.     property OnLogin: TLoginEvent
  92.       read FOnLogin write FOnLogin;
  93.     property OnLoggingIn: TLoggingInEvent
  94.       read FOnLoggingIn write FOnLoggingIn;
  95.     property OnLogout: TNotifyEvent
  96.       read FOnLogout write FOnLogout;
  97.     property OnLoggingOut: TLoggingOutEvent
  98.       read FOnLoggingOut write FOnLoggingOut;
  99.     property OnBadLogin: TNotifyEvent
  100.       read FOnBadLogin write FOnBadLogin;
  101.     property OnPasswordExpired: TPasswordExpiredEvent
  102.       read FOnPasswordExpired write FOnPasswordExpired;
  103.   end;
  104.  
  105. var
  106.   LoginManager: TLoginManager;
  107.  
  108. implementation
  109.  
  110. uses
  111.   Controls, Dialogs, DMLogin, PassInt;
  112.  
  113. { TDBList }
  114. function TDBList.Add(Item: TDatabase): Integer;
  115. begin
  116.   Result := inherited Add(Item);
  117. end;
  118.  
  119. { TLoginManager }
  120.  
  121. constructor TLoginManager.Create(AOwner: TComponent);
  122. begin
  123.   inherited Create(AOwner);
  124.  
  125.   { Establish connection to the data module code }
  126.   LoginDM := TLoginDM.Create(Self);
  127.  
  128.   FApplicationID := cNoAppID;
  129.   FUserID := cNoUserID;
  130.   FUserFullName := '';
  131.   FUserFirstName := '';
  132.   FUserLastName := '';
  133.   FNumAttemptsAllowed := DefNumAttempts;
  134.  
  135.   FApplicationDBs := TDBList.Create;
  136. end;
  137.  
  138. destructor TLoginManager.Destroy;
  139. begin
  140.   FApplicationDBs.Free;
  141. end;
  142.  
  143. procedure TLoginManager.Connect;
  144. var
  145.   I: Integer;
  146. begin
  147.   ConnectDB(FMainDB, FUsername, FPassword);
  148.   for I := 0 to FApplicationDBs.Count - 1 do
  149.     ConnectDB(FApplicationDBs.Items[I], FUsername, FPassword);
  150. end;
  151.  
  152. procedure TLoginManager.ConnectDB(DB: TDatabase; Username, Password: String);
  153. begin
  154.   if DB <> nil then
  155.     with DB do
  156.     begin
  157.       Connected := False;
  158.       LoginPrompt := False;
  159.       Params.Values['USER NAME'] := Username;
  160.       Params.Values['PASSWORD'] := Password;
  161.       KeepConnection := True;
  162.       Connected := True;
  163.     end;
  164. end;
  165.  
  166. procedure TLoginManager.Disconnect;
  167. var
  168.   I: Integer;
  169. begin
  170.   DisconnectDB(FMainDB);
  171.   for I := 0 to FApplicationDBs.Count - 1 do
  172.     DisconnectDB(FApplicationDBs.Items[I]);
  173. end;
  174.  
  175. procedure TLoginManager.DisconnectDB(DB: TDatabase);
  176. begin
  177.   if DB <> nil then
  178.     with DB do
  179.     begin
  180.       KeepConnection := False;
  181.       Connected := False;
  182.     end;
  183. end;
  184.  
  185. procedure TLoginManager.Login(UserName, Password, Server, Database: string);
  186. var
  187.   Cancel: Boolean;
  188. begin
  189.   Logout;
  190.  
  191.   FUsername := Username;
  192.   FPassword := Uppercase(Password);
  193.   try
  194.     { Any exception occurring within this block is considered a failed login attempt }
  195.  
  196.     { Deal with possible server/database name overrides }
  197.     SetServerName(Server);
  198.     SetDatabaseName(Database);
  199.  
  200.     { Connect to physical database }
  201.     Connect;
  202.     FUserID := cNoUserID;
  203.     LoginDM.GetUserValues(FUserID, FUserFirstName, FUserLastName,
  204.                           FDateLastLogin, FPasswordExpired);
  205.     FUserFullName := FUserFirstName + ' ' + FUserLastName;
  206.  
  207.     { Determine if user's password has expired... }
  208.     if FPasswordExpired then
  209.     begin
  210.       Cancel := True;
  211.       if Assigned(FOnPasswordExpired) then
  212.         FOnPasswordExpired(Self, Cancel);
  213.       if Cancel then
  214.         raise Exception.Create('Unable to login--user''s password has expired');
  215.     end;
  216.  
  217.     if Assigned(FOnLoggingIn) then
  218.     begin
  219.       FOnLoggingIn(Self, UserName, Password, Cancel);
  220.       begin
  221.         Disconnect;
  222.         Exit;
  223.       end;
  224.     end;
  225.  
  226.     LoginDM.PostAuditTrail(evtLoginSuccessful, '');
  227.     LoginDM.PostUserLoginDate;
  228.     FNumFailedAttempts := 0;
  229.   except
  230.     on E: Exception do
  231.     begin     { Failed login attempt }
  232.       Application.HandleException(Self);
  233.       Disconnect;
  234.       if Assigned(FOnBadLogin) then
  235.         FOnBadLogin(Self);
  236.  
  237.       { Post bad login event }
  238.       try
  239.         LoginDM.PostAuditTrail(evtLoginFail, 'Username: ' + FUsername);
  240.       except
  241.       end;
  242.  
  243.       { Count the number of failed attempts and shut down if the fail limit has been reached }
  244.       Inc(FNumFailedAttempts);
  245.       if FNumFailedAttempts >= NumAttemptsAllowed then
  246.       begin
  247.         MessageDlg(IntToStr(FNumFailedAttempts) +
  248.                    ' login attempts have failed.  ' +
  249.                    'Shutting down the application.',
  250.                    mtError, [mbOk], 0);
  251.         Application.Terminate;
  252.       end;
  253.  
  254.       FUserID := cNoUserID;
  255.       FUsername := '';
  256.       FPassword := '';
  257.       Exit;
  258.     end;
  259.   end;
  260.  
  261.   if Assigned(FOnLogin) then
  262.     FOnLogin(Self, UserName, Password);
  263. end;
  264.  
  265. procedure TLoginManager.Logout;
  266. var
  267.   Cancel: Boolean;
  268. begin
  269.   if FUserID <> cNoUserID then
  270.   begin
  271.     if Assigned(FOnLoggingOut) then
  272.     begin
  273.       Cancel := False;
  274.       FOnLoggingOut(Self, Cancel);
  275.       if Cancel then Exit;
  276.     end;
  277.  
  278.     Disconnect;
  279.  
  280.     if Assigned(FOnLogout) then FOnLogout(Self);
  281.     LoginDM.PostAuditTrail(evtLogout, '');
  282.     FUserID := cNoUserID;
  283.   end;
  284. end;
  285.  
  286. procedure TLoginManager.SetMainDB(Value: TDatabase);
  287. var
  288.   I: Integer;
  289. begin
  290.   if Value <> FMainDB then
  291.   begin
  292.     FMainDB := Value;
  293.     LoginDM.dbInternal.AliasName := FMainDB.AliasName;
  294.  
  295.     { Initialize the dataset components in the data module }
  296.     for I := 0 to LoginDM.ComponentCount - 1 do
  297.       if LoginDM.Components[I] is TDBDataSet then
  298.         with TDBDataSet(LoginDM.Components[I]) do
  299.         begin
  300.           if DatabaseName = '' then
  301.           begin
  302.             Active := False;
  303.             DatabaseName := FMainDB.DatabaseName;
  304.           end;
  305.         end;
  306.  
  307.     { ServerName and/or DatabaseName overrides could have been registered already.
  308.       If not, then we must make sure the ServerName and DatabaseName
  309.       properties return the values given in the application's TDatabase component,
  310.       or in the alias definition. }
  311.  
  312.     FCallersServerName := GetDBParamValue('SERVER NAME');
  313.     if FServerName <> '' then SetDBParamValue('SERVER NAME', FServerName)
  314.     else FServerName := FCallersServerName;
  315.  
  316.     FCallersDatabaseName := GetDBParamValue('DATABASE NAME');
  317.     if FDatabaseName <> '' then SetDBParamValue('DATABASE NAME', FDatabaseName)
  318.     else FDatabaseName := FCallersDatabaseName;
  319.   end;
  320. end;
  321.  
  322. procedure TLoginManager.ChangePassword(OldPassword, NewPassword: string);
  323. var
  324.   Status: Word;
  325.   StatusText: PChar;
  326. begin
  327.   if Uppercase(OldPassword) <> FPassword then
  328.     raise Exception.Create('Unable to change password--current password incorrect.');
  329.  
  330.   StatusText := StrAlloc(255);
  331.   try
  332.     if PassInt.ChangePassword(
  333.                  PChar(FMainDB.AliasName),
  334.                  PChar(FServerName),
  335.                  PChar(FDatabaseName),
  336.                  PChar(FUsername),
  337.                  PChar(OldPassword),
  338.                  PChar(NewPassword),
  339.                  StatusText) <> 0 then
  340.       raise Exception.Create(StrPas(StatusText));
  341.  
  342.     { Set the new password }
  343.     FPassword := Uppercase(NewPassword);
  344.     { Reconnect database(s) with new password }
  345.     Connect;
  346.     { Post a "change password" in the audit trail }
  347.     LoginDM.PostAuditTrail(evtChangePassword, '');
  348.   finally
  349.     StrDispose(StatusText);
  350.   end;
  351. end;
  352.  
  353. function TLoginManager.GetDBParamValue(ParamName: string): string;
  354. { Returns the value for the given database parameter. }
  355. var
  356.   DBParams: TStringList;
  357. begin
  358.  
  359.   { First, check for specific values in the application's main
  360.     TDatabase component. }
  361.   Result := FMainDB.Params.Values[ParamName];
  362.  
  363.   { Failing that, get the value from the alias definition. }
  364.   if Result = '' then
  365.   begin
  366.     DBParams := TStringList.Create;
  367.     try
  368.       Session.GetAliasParams(FMainDB.AliasName, DBParams);
  369.       Result := DBParams.Values[ParamName];
  370.     finally
  371.       DBParams.Free;
  372.     end;
  373.   end;
  374. end;
  375.  
  376. procedure TLoginManager.SetDBParamValue(ParamName, Value: string);
  377. begin
  378.   FMainDB.Params.Values[ParamName] := Value;
  379.   LoginDM.dbInternal.Params.Values[ParamName] := Value;
  380. end;
  381.  
  382. procedure TLoginManager.SetDatabaseName(Value: String);
  383. { When used to register the TLoginManager class, this overrides the "Database Name"
  384.   alias property in the MainDB component.  It is illegal to set this value once
  385.   the MainDB database component is connected.
  386.  
  387.   This code must allow for the DatabaseName property to be set either before or after
  388.   the user has registered the MainDB database component. }
  389. begin
  390.   FDatabaseName := ANSIUppercase(Value);
  391.  
  392.   { If MainDB has already been registered... }
  393.   if FMainDB <> nil then
  394.   begin
  395.     if FMainDB.Connected or LoginDM.dbInternal.Connected then
  396.       raise Exception.Create('Cannot set TLoginManager.DatabaseName once database is connected');
  397.     if FDatabaseName = '' then
  398.       FDatabaseName := FCallersDatabaseName;
  399.     SetDBParamValue('DATABASE NAME', FDatabaseName);
  400.   end;
  401. end;
  402.  
  403. procedure TLoginManager.SetServerName(Value: string);
  404. { When used to register the TLoginManager class, this overrides the "Server Name"
  405.   alias property in the MainDB component.  It is illegal to set this value once
  406.   the MainDB database component is connected.
  407.  
  408.   This code must allow for the ServerName property to be set either before or after
  409.   the user has registered the MainDB database component. }
  410. begin
  411.   FServerName := ANSIUppercase(Value);
  412.  
  413.   { If MainDB has already been registered... }
  414.   if FMainDB <> nil then
  415.   begin
  416.     if FMainDB.Connected or LoginDM.dbInternal.Connected then
  417.       raise Exception.Create('Cannot set TLoginManager.ServerName once database is connected');
  418.     if FServerName = '' then
  419.       FServerName := FCallersServerName;
  420.     SetDBParamValue('SERVER NAME', FServerName);
  421.   end;
  422. end;
  423.  
  424. initialization
  425.   LoginManager := nil;
  426.   LoginManager := TLoginManager.Create(Application);
  427. end.
  428.  
  429.